home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Internet Tools 1993 July / Internet Tools.iso / RockRidge / mail / vm / vm-5.33beta / vm-motion.el < prev    next >
Encoding:
Text File  |  1991-04-06  |  9.8 KB  |  277 lines
  1. ;;; Commands to move around in a VM folder
  2. ;;; Copyright (C) 1989, 1990 Kyle E. Jones
  3. ;;;
  4. ;;; This program is free software; you can redistribute it and/or modify
  5. ;;; it under the terms of the GNU General Public License as published by
  6. ;;; the Free Software Foundation; either version 1, or (at your option)
  7. ;;; any later version.
  8. ;;;
  9. ;;; This program is distributed in the hope that it will be useful,
  10. ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12. ;;; GNU General Public License for more details.
  13. ;;;
  14. ;;; You should have received a copy of the GNU General Public License
  15. ;;; along with this program; if not, write to the Free Software
  16. ;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  17.  
  18. (defun vm-record-and-change-message-pointer (old new)
  19.   (setq vm-last-message-pointer old
  20.     vm-message-pointer new
  21.     vm-message-pointer new))
  22.  
  23. (defun vm-goto-message (n)
  24.   "Go to the message numbered N.
  25. Interactively N is the prefix argument.  If no prefix arg is provided
  26. N is prompted for in the minibuffer.
  27.  
  28. If vm-follow-summary-cursor is non-nil this command first tries
  29. to follow the summary cursor to a new message.  If a new message
  30. is selected in this way, no further action is taken.  I.e. you can move
  31. the cursor in the summary buffer, press RETURN and select a new
  32. message without typing in a message number."
  33.   (interactive
  34.    (list
  35.     (cond ((vm-follow-summary-cursor) nil)
  36.       (current-prefix-arg (prefix-numeric-value current-prefix-arg))
  37.       (t (vm-read-number "Go to message: ")))))
  38.   (if (null n)
  39.       ()                ; nil means work has been done already
  40.     (vm-select-folder-buffer)
  41.     (vm-check-for-killed-summary)
  42.     (vm-error-if-folder-empty)
  43.     (let ((cons (nthcdr (1- n) vm-message-list)))
  44.       (if (null cons)
  45.       (error "No such message."))
  46.       (if (eq vm-message-pointer cons)
  47.       (vm-preview-current-message)
  48.     (vm-record-and-change-message-pointer vm-message-pointer cons)
  49.     (setq vm-need-summary-pointer-update t)
  50.     (vm-preview-current-message)))))
  51.  
  52. (defun vm-goto-message-last-seen ()
  53.   "Go to the message last previewed."
  54.   (interactive)
  55.   (vm-select-folder-buffer)
  56.   (vm-check-for-killed-summary)
  57.   (vm-error-if-folder-empty)
  58.   (if vm-last-message-pointer
  59.       (progn
  60.     (vm-record-and-change-message-pointer vm-message-pointer
  61.                           vm-last-message-pointer)
  62.     (setq vm-need-summary-pointer-update t)
  63.     (vm-preview-current-message))))
  64.  
  65. (put 'beginning-of-folder 'error-conditions '(beginning-of-folder error))
  66. (put 'beginning-of-folder 'error-message "Beginning of folder")
  67. (put 'end-of-folder 'error-conditions '(end-of-folder error))
  68. (put 'end-of-folder 'error-message "End of folder")
  69.  
  70. (defun vm-check-count (count)
  71.   (if (>= count 0)
  72.       (if (< (length vm-message-pointer) count)
  73.       (signal 'end-of-folder nil))
  74.     (if (< (1+ (- (length vm-message-list) (length vm-message-pointer)))
  75.        (vm-abs count))
  76.     (signal 'beginning-of-folder nil))))
  77.  
  78. (defun vm-move-message-pointer (direction)
  79.   (let ((mp vm-message-pointer))
  80.     (if (eq direction 'forward)
  81.     (progn
  82.       (setq mp (cdr mp))
  83.       (if (null mp)
  84.           (if vm-circular-folders
  85.           (setq mp vm-message-list)
  86.         (signal 'end-of-folder nil))))
  87.       (setq mp (vm-reverse-link-of (car mp)))
  88.       (if (null mp)
  89.       (if vm-circular-folders
  90.           (setq mp (vm-last vm-message-list))
  91.         (signal 'beginning-of-folder nil))))
  92.     (setq vm-message-pointer mp)))
  93.  
  94. (defun vm-should-skip-message (mp &optional skip-dogmatically)
  95.   (if skip-dogmatically
  96.       (or (and vm-skip-deleted-messages
  97.            (vm-deleted-flag (car mp)))
  98.       (and vm-skip-read-messages
  99.            (or (vm-deleted-flag (car mp))
  100.            (not (or (vm-new-flag (car mp))
  101.                 (vm-unread-flag (car mp)))))))
  102.     (or (and (eq vm-skip-deleted-messages t)
  103.          (vm-deleted-flag (car mp)))
  104.     (and (eq vm-skip-read-messages t)
  105.          (or (vm-deleted-flag (car mp))
  106.          (not (or (vm-new-flag (car mp))
  107.               (vm-unread-flag (car mp)))))))))
  108.  
  109. (defun vm-next-message (&optional count retry signal-errors)
  110.   "Go forward one message and preview it.
  111. With prefix arg COUNT, go forward COUNT messages.  A negative COUNT
  112. means go backward.  If the absolute value of COUNT > 1 the values of the
  113. variables vm-skip-deleted-messages and vm-skip-read-messages are
  114. ignored."
  115.   (interactive "p\np\np")
  116.   (vm-select-folder-buffer)
  117.   (vm-sanity-check-modification-flag)
  118.   (vm-check-for-killed-summary)
  119.   (and signal-errors (vm-error-if-folder-empty))
  120.   (or count (setq count 1))
  121.   (let ((oldmp vm-message-pointer)
  122.     (error)
  123.     (direction (if (> count 0) 'forward 'backward))
  124.     (count (vm-abs count)))
  125.     (cond
  126.      ((null vm-message-pointer)
  127.       (setq vm-message-pointer vm-message-list))
  128.      ((/= count 1)
  129.       (condition-case ()
  130.       (while (not (zerop count))
  131.         (vm-move-message-pointer direction)
  132.         (vm-decrement count))
  133.     (beginning-of-folder (setq error 'beginning-of-folder))
  134.     (end-of-folder (setq error 'end-of-folder))))
  135.      (t
  136.       (condition-case ()
  137.       (progn
  138.         (vm-move-message-pointer direction)
  139.         (while (and (not (eq oldmp vm-message-pointer))
  140.             (vm-should-skip-message vm-message-pointer t))
  141.           (vm-move-message-pointer direction))
  142.         ;; Retry the move if we've gone a complete circle and and
  143.         ;; retires are allowed there are other messages besides this
  144.         ;; one.
  145.         (and (eq vm-message-pointer oldmp) retry (cdr vm-message-list)
  146.          (progn
  147.            (while (and (not (eq oldmp vm-message-pointer))
  148.                    (vm-should-skip-message vm-message-pointer))
  149.              (vm-move-message-pointer direction)))))
  150.     (beginning-of-folder
  151.      ;; we bumped into the beginning of the folder without finding
  152.      ;; a sutiable stopping point; retry the move if we're allowed.
  153.      (setq vm-message-pointer oldmp)
  154.      ;; if we crash and burn during the retry, we make sure the
  155.      ;; message pointer is restored to its old value.
  156.      (if retry
  157.          (setq vm-message-pointer
  158.            (condition-case ()
  159.                (let ((vm-message-pointer vm-message-pointer))
  160.              (vm-move-message-pointer direction)
  161.              (while (vm-should-skip-message vm-message-pointer)
  162.                (vm-move-message-pointer direction))
  163.              vm-message-pointer )
  164.              (beginning-of-folder
  165.               (setq error 'beginning-of-folder)
  166.               oldmp )))
  167.        (setq error 'beginning-of-folder)))
  168.     (end-of-folder
  169.      ;; we bumped into the end of the folder without finding
  170.      ;; a suitable stopping point; retry the move if we're allowed.
  171.      (setq vm-message-pointer oldmp)
  172.      ;; if we crash and burn during the retry, we make sure the
  173.      ;; message pointer is restored to its old value.
  174.      (if retry
  175.          (setq vm-message-pointer
  176.            (condition-case ()
  177.                (let ((vm-message-pointer vm-message-pointer))
  178.              (vm-move-message-pointer direction)
  179.              (while (vm-should-skip-message vm-message-pointer)
  180.                (vm-move-message-pointer direction))
  181.              vm-message-pointer )
  182.              (end-of-folder
  183.               (setq error 'end-of-folder)
  184.               oldmp )))
  185.        (setq error 'end-of-folder))))))
  186.     (if (not (eq vm-message-pointer oldmp))
  187.     (progn
  188.       (vm-record-and-change-message-pointer oldmp vm-message-pointer)
  189.       (setq vm-need-summary-pointer-update t)
  190.       (vm-preview-current-message)))
  191.     (and error signal-errors
  192.      (signal error nil))))
  193.  
  194. (defun vm-previous-message (&optional count retry signal-errors)
  195.   "Go back one message and preview it.
  196. With prefix arg COUNT, go backward COUNT messages.  A negative COUNT
  197. means go forward.  If the absolute value of COUNT > 1 the values of the
  198. variables vm-skip-deleted-messages and vm-skip-read-messages are
  199. ignored."
  200.   (interactive "p\np\np")
  201.   (or count (setq count 1))
  202.   (vm-select-folder-buffer)
  203.   (vm-next-message (- count) retry signal-errors))
  204.  
  205. (defun vm-Next-message (&optional count)
  206.   "Like vm-next-message but will not skip messages."
  207.   (interactive "p")
  208.   (vm-select-folder-buffer)
  209.   (let (vm-skip-deleted-messages vm-skip-read-messages)
  210.     (vm-next-message count nil t)))
  211.  
  212. (defun vm-Previous-message (&optional count)
  213.   "Like vm-previous-message but will not skip messages."
  214.   (interactive "p")
  215.   (vm-select-folder-buffer)
  216.   (let (vm-skip-deleted-messages vm-skip-read-messages)
  217.     (vm-previous-message count)))
  218.  
  219. (defun vm-next-unread-message ()
  220.   "Move forward to the nearest new or unread message, if there is one."
  221.   (interactive)
  222.   (vm-select-folder-buffer)
  223.   (vm-check-for-killed-summary)
  224.   (condition-case ()
  225.       (let ((vm-skip-read-messages t)
  226.         (oldmp vm-message-pointer))
  227.     (vm-next-message 1 nil t)
  228.     ;; in case vm-circular-folder is non-nil
  229.     (and (eq vm-message-pointer oldmp) (signal 'end-of-folder nil)))
  230.     (end-of-folder (message "No next unread message"))))
  231.  
  232. (defun vm-previous-unread-message ()
  233.   "Move backward to the nearest new or unread message, if there is one."
  234.   (interactive)
  235.   (vm-select-folder-buffer)
  236.   (vm-check-for-killed-summary)
  237.   (condition-case ()
  238.       (let ((vm-skip-read-messages t)
  239.         (oldmp vm-message-pointer))
  240.     (vm-previous-message)
  241.     ;; in case vm-circular-folder is non-nil
  242.     (and (eq vm-message-pointer oldmp) (signal 'beginning-of-folder nil)))
  243.     (beginning-of-folder (message "No previous unread message"))))
  244.  
  245. (defun vm-find-first-unread-message ()
  246.   (let (mp unread-mp)
  247.     (setq mp vm-message-list)
  248.     (while mp
  249.       (if (and (vm-new-flag (car mp)) (not (vm-deleted-flag (car mp))))
  250.       (setq unread-mp mp mp nil)
  251.     (setq mp (cdr mp))))
  252.     (if (null unread-mp)
  253.     (progn
  254.       (setq mp vm-message-list)
  255.       (while mp
  256.         (if (and (vm-unread-flag (car mp))
  257.              (not (vm-deleted-flag (car mp))))
  258.         (setq unread-mp mp mp nil)
  259.           (setq mp (cdr mp))))))
  260.     unread-mp))
  261.  
  262. (defun vm-thoughtfully-select-message ()
  263.   (if (or (null vm-message-pointer) (not (eq vm-system-state 'reading)))
  264.       (let ((mp (vm-find-first-unread-message)))
  265.     (if mp
  266.         (progn
  267.           (if vm-message-pointer
  268.           (vm-record-and-change-message-pointer vm-message-pointer mp)
  269.         (setq vm-message-pointer mp))
  270.           (setq vm-need-summary-pointer-update t)
  271.           (vm-preview-current-message)
  272.           t )
  273.       (if vm-message-pointer
  274.           nil
  275.         (vm-Next-message)
  276.         t )))))
  277.